Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/MAILSCAN.PAS

Pascal/Delphi Source File | 1997-03-02 | 59KB | 1,874 lines

UNIT MailScan;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Mail processor                                Last changed: 02.03.97  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-97 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, Dos, OpDate, OpString, OpDos, OpCrt, OpCmd, OpEntry, OpWindow, OpMenu,
     OpFrame, OpField,
     Input, Globals, OproUtil, StrUtil, MailUtil, Crc, NetFile, Send2Utl,
     LogFile, NodeList, FileUtil, PopTypes, MailPack, PFix, Usage, MSDefs;

TYPE
  SendPktPtr=^SendPktType;
  SendPktType=RECORD
    PktFile    : FILE;
    PktBufPos,
    PktBufSiz  : WORD;
    PktBuf     : Pointer;
    PktAdr     : TFidoAddress; { Address of receiver }
    Next       : SendPktPtr;
  END;

PROCEDURE RunMailScanner(Flags:LongInt);

IMPLEMENTATION

USES OpSelect, OpRoot,
     Util, ArcView, OpusMsg, Resource, MSMisc;

PROCEDURE FlushPkt(VAR Sp:SendPktPtr);
BEGIN
  WITH Sp^ DO
  BEGIN
    BLOCKWRITE(PktFile,PktBuf^,PktBufPos);
    PktBufPos:=0;
  END;
END;

PROCEDURE AddToPktBuffer(VAR Sp:SendPktPtr; VAR BufAdr; Num:WORD);
VAR
  BufOfs:WORD;
  x:LongInt;
BEGIN
  WITH Sp^ DO
  BEGIN
    IF PktBufSiz=0 THEN BlockWrite(PktFile,BufAdr,Num) ELSE
    BEGIN
      BufOfs:=0;
      REPEAT
        x:=PktBufSiz-PktBufPos;
        IF x>Num THEN x:=Num;
        MoveFast(Ct(BufAdr)[BufOfs+1],CT(PktBuf^)[PktBufPos+1],x);
        INC(PktBufPos,x);
        IF PktBufPos=PktBufSiz THEN FlushPkt(Sp);
        DEC(Num,WORD(x));
        INC(BufOfs,WORD(x));
      UNTIL Num=0;
    END;
  END;
END;

PROCEDURE RunMailScanner(Flags:LongInt);
VAR
  GemRp                : RunParametersType;
  QBase                : ^QBBSBaseType;
  OpusBase             : ^OpusBaseType;

  Pmh                  : TPktMsgHeader;
  PMHByte              : ARRAY[1..SizeOf(TPktMsgHeader)] OF BYTE ABSOLUTE Pmh;
  Dupe                 : DupeTabType;
  Buffer               : Pointer;
  MailScanWin          : WindowPtr;
  IsInSeenBy           : ARRAY[1..2,1..50] OF Boolean;
  PktBufCount,
  ScannerAreaNum,
  NumPath, NumSeenBy,
  SeenByOffSet, OriginOffSet,
  PathOffSet, InBuffer,
  BufPos,BadNum,TagEndPos,
  MsgSlut,RealMsgLen,
  MaxPktBuffer         : WORD;
  Cmd, DupeMsgNum,
  BadMsgNum, MatrixNum : INTEGER;
  SeenByTab            : ^SeenByTabType;
  PathTab              : ^PathTabType;
  PktEnd,
  PktError             : Boolean;
  PktFile, DupeFile    : TNetFile;
  TmpAreas, AreasBBS   : AreasBBSPtr;
  Msg                  : MessageTypePtr;
  SendPkt              : SendPktPtr;
  ESR                  : TPoPEntryScreen;
  MsgScannedCount,
  MsgSentCount,
  MsgTossedCount,
  MsgBadCount,
  MsgDupeCount         : LongInt;
  BasePath             : PathStr;
  rp                   : Pointer;
  CurrentAKA,i         : BYTE;
  PktOrig,PktDest      : TFidoAddress;
  StartTime,EndTime,
  MSTimer              : DateTimeRec;
  OldTagName           : S40;

  PROCEDURE GetDT(VAR DT:DateTimeRec);
  BEGIN
    WITH Dt DO
    BEGIN
      T:=CurrentTime;
      D:=Today;
    END;
  END;

  FUNCTION StopMSTimer:LongInt;
  VAR
    Now:DateTimeRec;
    Days:WORD;
    Secs:LongInt;
  BEGIN
    GetDT(Now);
    DateTimeDiff(Now,MSTimer,Days,Secs);
    IF (Days=0) AND (Secs=0) THEN Secs:=1;
    StopMSTimer:=Secs+LongInt(LongInt(Days)*SecondsInDay);
  END;

  PROCEDURE OpusMsgToMSMsg(VAR h:MsgHdrType; p:Pointer; Len:WORD; VAR Msg:MessageTypePtr);
  BEGIN
    FillChar(Msg^,SizeOf(Msg^),0);
    WITH Msg^ DO
    BEGIN
      MoveFast(p^,TextBody,Len);
      MoveFast(h.datetime,pmh.time,20);
      WhoTo:=AsciiZ2Str(h.ToUser,36);
      WhoFrom:=AsciiZ2Str(h.FromUser,36);
      Subject:=AsciiZ2Str(h.Subject,72);
      OrigNet:=h.OrigNet;
      OrigNode:=h.OrigNode;
      DestNet:=h.DestNet;
      DestNode:=h.DestNode;
      MsgLen:=Len;
    END;
  END;

  FUNCTION SecurityOK:Boolean;
  VAR
    i:BYTE;
  BEGIN
    SecurityOK:=True;
    IF NOT Cfg.MailScanner.Secure THEN Exit;
    WITH TmpAreas^.Area DO
    BEGIN
      FOR i:=1 TO TmpAreas^.SendNum[1] DO
        WITH SendToTabType(TmpAreas^.SendTo[1]^)[i] DO
          IF (Node=Msg^.OrigNode) AND (Net=Msg^.OrigNet) THEN Exit;
    END;
    SecurityOK:=False;
  END;

  PROCEDURE Message(CONST s: S60; YPos: BYTE);
  BEGIN
    MailScanWin^.wFastWrite(CPad(s,60),YPos,16,Cfg.Color[2].HighLightColor);
  END;

  PROCEDURE UsedMemStatus;
  BEGIN
    Message('Available='+LongIntForm('########',MaxAvail)+', # of buffers='+Long2Str(PktBufCount),18);
  END;

  PROCEDURE DoMailScan;
  VAR
    i,j       : Byte;
    DelSr, sr : SearchRec;
    NodeStat  : TNodeStat;

    FUNCTION IsADupeMsg : Boolean;
    LABEL
      NoMore,GetIt;
    VAR
      i:BYTE;
      x:WORD;
      Found,b:Boolean;
      fp,n:LongInt;
      Td:DupeType;
      p:DupeMemTypePtr;
    BEGIN
      FillChar(td,SizeOf(Td),0);
      WITH Td DO
      BEGIN
        FOR i:=1 TO Length(Msg^.whoto) DO
          WhoToCRC:=UpdCrc16(BYTE(Msg^.WhoTo[i]),WhoToCRC);
        FOR i:=1 TO Length(Msg^.WhoFrom) DO
          WhoFromCRC:=UpdCrc16(BYTE(Msg^.WhoFrom[i]),WhoFromCRC);
        FOR i:=1 TO Length(Msg^.Subject) DO
          SubjectCRC:=UpdCrc16(BYTE(Msg^.Subject[i]),SubjectCRC);
        FOR i:=15 TO 34 DO
          DateCRC:=UpdCrc16(PMHByte[i],DateCRC);
      END;
      i:=0;
      REPEAT
        INC(i);
        Found:=(Dupe[i]^.d.Tag=Msg^.Tag);
      UNTIL (i=MaxDupeBases) OR (Found) OR (Dupe[i]^.d.Tag='');
      IF NOT Found THEN
      BEGIN
        IF Dupe[i]^.d.Tag='' THEN
        BEGIN
GetIt:
          WITH Dupe[i]^ DO
          BEGIN
            DFPos:=TmpAreas^.DupePos;
            IF DFPos=-1 THEN
            BEGIN
              DFPos:=DupeFile.FILESIZE;
              TmpAreas^.DupePos:=DFPos;
              FillChar(D,SIZEOF(DupeBaseType),0);
              d.Tag:=Msg^.Tag;
              DupeFile.PutRec(D,DFPos);
              DupeFile.Lock(DFPos,Wait);
            END ELSE
              DupeFile.GetRec(D,DFPos,Keep,Wait);
          END;
        END
        ELSE
        BEGIN
          WITH Dupe[MaxDupeBases]^ DO
          BEGIN
            DupeFile.PutRec(d,DFPos);
            i:=MaxDupeBases;
            GOTO GetIt;
          END;
        END;
      END
      ELSE
      BEGIN
        IF i>1 THEN
        BEGIN
          p:=Dupe[i];
          MoveFast(Dupe[1],Dupe[2],(i-1)*SizeOf(Pointer));
          Dupe[1]:=p;
        END;
      END;
      WITH Dupe[1]^.d DO
        IF OldTagName<>Tag THEN
        BEGIN
          Message(Tag,6);
          OldTagName:=Tag;
        END;
      b:=False;
      FOR x:=1 TO Dupe[1]^.d.SigNum DO
        WITH Dupe[1]^.d.Sig[x] DO
        BEGIN
          IF (DateCRC=Td.DateCRC) AND
             (WhoFromCRC=Td.WhoFromCRC) AND
             (WhoToCRC=Td.WhoToCRC) AND
             (SubjectCRC=Td.SubjectCRC) THEN
          BEGIN
            b:=True;
            GOTO NoMore;
          END;
        END;
      WITH Dupe[1]^.d DO
      BEGIN
        IF SigNum=1000 THEN
        BEGIN
          MoveFast(Sig[2],Sig[1],999*SizeOf(DupeType));
        END ELSE
          INC(SigNum);
        Sig[SigNum]:=Td;
      END;
NoMore:
      IsADupeMsg:=b;
    END;

    PROCEDURE SetUpPathAndSeenBy;
    VAR
      j,i:WORD;

      FUNCTION AddToSeenBy(CONST A: TFidoAddress):Boolean;
      VAR
        b:Boolean;
        i,CurNet,LastNetPos:INTEGER;
      BEGIN
        b:=True;
        CurNet:=SeenByTab^[2];
        LastNetPos:=1;
        i:=2;
        WHILE (i<NumSeenBy) AND (CurNet<A.Net) DO
        BEGIN
          INC(i);
          IF SeenByTab^[i]=-1 THEN
          BEGIN
            LastNetPos:=i;
            CurNet:=SeenByTab^[i+1];
            INC(i,2);
          END;
        END;
        IF CurNet<>A.Net THEN
        BEGIN
          IF CurNet<A.Net THEN
          BEGIN
            SeenByTab^[NumSeenBy+1]:=-1;
            SeenByTab^[NumSeenBy+2]:=A.Net;
            SeenByTab^[NumSeenBy+3]:=A.Node;
            LastNetPos:=NumSeenBy+1;
            INC(NumSeenBy,3);
          END ELSE
          BEGIN
            MoveFast(SeenByTab^[LastNetPos],SeenByTab^[LastNetPos+3],2*(NumSeenBy-LastNetPos+1));
            SeenByTab^[LastNetPos]:=-1;
            SeenByTab^[LastNetPos+1]:=A.Net;
            SeenByTab^[LastNetPos+2]:=A.Node;
            INC(NumSeenBy,3);
          END;
        END ELSE
        BEGIN
          i:=LastNetPos+2;
          WHILE (i<NumSeenBy) AND (SeenByTab^[i]<>-1) AND (SeenByTab^[i]<A.Node) DO
            INC(i);
          IF (SeenByTab^[i]=A.Node) THEN
            b:=False
          ELSE
          BEGIN
            IF i<NumSeenBy THEN
            BEGIN
              MoveFast(SeenByTab^[i],SeenByTab^[i+1],2*(NumSeenBy-i+1));
              SeenByTab^[i]:=A.Node;
              INC(NumSeenBy);
            END ELSE
            BEGIN
              INC(NumSeenBy);
              SeenByTab^[NumSeenBy]:=A.Node;
            END;
          END;
        END;
        AddToSeenBy:=b;
      END;

      PROCEDURE CleanSeenByAndPath;

        PROCEDURE CleanIt(VAR TabAdr; VAR Num:WORD);
        VAR
          First,Last,i : WORD;
          Found : Boolean;
        BEGIN
          i:=0;
          Found:=False;
          REPEAT
            INC(i);
            IF (SeenByTabType(TabAdr)[i]=-1) AND
               (SeenByTabType(TabAdr)[i+1]=Cfg.PointNet) THEN Found:=True;
          UNTIL Found OR (i>=Num);
          IF Found THEN
          BEGIN
            First:=i;
            Last:=0;
            REPEAT
              INC(i);
              IF SeenByTabType(TabAdr)[i]=-1 THEN Last:=i;
            UNTIL (Last>0) OR (i>Num);
            IF Last=0 THEN { Last of nets }
            BEGIN
              Num:=First-1;
            END ELSE
            BEGIN { In the middle of nowhere }
              MoveFast(SeenByTabType(TabAdr)[Last],SeenByTabType(TabAdr)[First],(Num-Last+1)*2);
              INC(Num,(First-Last));
            END;
          END;
        END;

      BEGIN
        CleanIt(SeenByTab^,NumSeenBy);
        CleanIt(PathTab^,NumPath);
      END;

    BEGIN
      { Insert receiving nodes in seenby }
      FOR j:=1 TO 2 DO
        FOR i:=1 TO TmpAreas^.SendNum[j] DO
          WITH SendToTabType(TmpAreas^.SendTo[j]^)[i] DO
          BEGIN
            IF (Net<>Cfg.PointNet) AND (Point=0) THEN
              IsInSeenBy[j,i]:=NOT AddToSeenBy(SendToTabType(TmpAreas^.SendTo[j]^)[i])
            ELSE
            BEGIN
              IsInSeenBy[j,i]:=CmpAdr(SendToTabType(TmpAreas^.SendTo[j]^)[i],PktOrig);
            END;
          END;
      IF Cfg.MailScanner.SetAKASent THEN
      BEGIN
        j:=TmpAreas^.Area.UsedAka;
        IF j=0 THEN j:=Cfg.MainAdrNum;
        FOR i:=1 TO MaxAddresses DO
          IF Cfg.Addresses[i].Zone=Cfg.Addresses[j].Zone THEN
            AddToSeenBy(Cfg.Addresses[i]);
      END;
      { Append our own number in path }
      IF CFg.Addresses[CurrentAKA].Point=0 THEN
      BEGIN
        i:=NumPath;
        IF i>0 THEN
        BEGIN
          WHILE (PathTab^[i]<>-1) DO
            DEC(i);
        END ELSE
        BEGIN
          i:=1;
          PathTab^[1]:=-1;
          PathTab^[2]:=Cfg.Addresses[CurrentAKA].Net;
        END;
        IF PathTab^[i+1]<>Cfg.Addresses[CurrentAKA].Net THEN
        BEGIN
          INC(NumPath,2);
          PathTab^[NumPath-1]:=-1;
          PathTab^[NumPath]:=Cfg.Addresses[CurrentAKA].Net;
        END;
        INC(NumPath);
        PathTab^[NumPath]:=Cfg.Addresses[CurrentAKA].Node;
        CleanSeenByAndPath;
      END;
    END;

    PROCEDURE InitPathAndSeenBy;
    BEGIN
      SeenByOffSet:=Msg^.MsgLen;
      NumSeenBy:=3;
      SeenByTab^[1]:=-1;
      IF Cfg.Addresses[CurrentAKA].Point=0 THEN
      BEGIN
        SeenByTab^[2]:=cfg.Addresses[CurrentAKA].net;
        SeenByTab^[3]:=cfg.Addresses[CurrentAKA].node;
      END ELSE
      BEGIN
        SeenByTab^[2]:=Cfg.PointNet;
        SeenByTab^[3]:=Cfg.Addresses[CurrentAKA].Point;
      END;
      NumPath:=2;
      PathTab^[1]:=-1;
      PathTab^[2]:=Cfg.Addresses[CurrentAKA].Net;
      SetupPathAndSeenBy;
    END;

    PROCEDURE PrepareMessageBuffer(HideSB:Boolean);
    VAR
      kw:S10;

      PROCEDURE AddBuffer(VAR TabAdr; VAR BufPos:WORD; Num:WORD; CONST Header:S10);
      VAR
        Tab:ARRAY[1..10000] OF INTEGER ABSOLUTE TabAdr;
        CurNet:INTEGER;
        n:WORD;
        s:STRING;
      BEGIN
        n:=2;
        CurNet:=Tab[2];
        REPEAT
          s:=Header;
          REPEAT
            INC(n);
            IF (LENGTH(s)=LENGTH(Header)) THEN
            BEGIN
              IF Tab[n]=-1 THEN
              BEGIN
                INC(n,2);
                CurNet:=Tab[n-1];
              END;
              s:=s+' '+Long2Str(CurNet)+'/'+Long2Str(Tab[n]);
            END ELSE
            BEGIN
              IF Tab[n]=-1 THEN
              BEGIN
                INC(n,2);
                CurNet:=Tab[n-1];
                s:=s+' '+Long2Str(CurNet)+'/'+Long2Str(Tab[n]);
              END ELSE
              BEGIN
                s:=s+' '+Long2Str(Tab[n]);
              END;
            END;
          UNTIL (LENGTH(s)>76) OR (n>=Num);
          s:=s+#13;
          MoveFast(s[1],Msg^.TextBody[BufPos],LENGTH(s));
          INC(BufPos,LENGTH(s));
        UNTIL (n>=Num);
      END;

    BEGIN
      IF HideSB THEN kw:=#1'SEEN-BY:' ELSE kw:='SEEN-BY:';
      AddBuffer(SeenByTab^,SeenByOffSet,NumSeenBy,kw);
      AddBuffer(PathTab^,SeenByOffSet,NumPath,#1'PATH:');
      Msg^.TextBody[SeenByOffSet]:=#0;
    END;

    PROCEDURE TossIntoArea(VAR Dir:PathStr; VAR Num:INTEGER; Offset:WORD);
    VAR
      o:MsgHdrType;
    BEGIN
      IF Dir<>'' THEN
      BEGIN
        IF Msg^.TextBody[Msg^.MsgLen]<>#0 THEN
        BEGIN
          INC(Msg^.MsgLen);
          Msg^.TextBody[Msg^.MsgLen]:=#0;
        END;
        FillChar(o,SizeOf(o),0);
        WITH o DO
        BEGIN
          MoveFast(Msg^.WhoFrom[1],FromUser,LENGTH(Msg^.WhoFrom));
          MoveFast(Msg^.WhoTo[1],ToUser,LENGTH(Msg^.WhoTo));
          MoveFast(Msg^.Subject[1],Subject,LENGTH(Msg^.Subject));
          MoveFast(pmh.Time,DateTime,20);
          DestNode:=pmh.DestNode;
          OrigNode:=pmh.OrigNode;
          Cost:=pmh.Cost;
          OrigNet:=pmh.OrigNet;
          DestNet:=pmh.DestNet;
          Attribute:=pmh.attr;
        END;
        INC(Num);
{$IFDEF OS2}
        WriteMsg(Dir,Num,o,Msg^.MsgLen,Ptr({Seg(Msg^.TextBody[OffSet]),}OFS(Msg^.TextBody[OffSet])));
{$ELSE}
        WriteMsg(Dir,Num,o,Msg^.MsgLen,PTR(Seg(Msg^.TextBody[OffSet]),OFS(Msg^.TextBody[OffSet])));
{$ENDIF}
      END;
    END;

    PROCEDURE WriteHudsonMessage(VAR BufAdr; MsgStart,MsgSlut:WORD; BNum:BYTE);
    VAR
      Num,i:WORD;
    BEGIN
      QBase^.MsgHdr.Board:=BNum;
      INC(QBase^.MsgInfo.TotalActive);
      INC(QBase^.MsgInfo.ActiveMsgs[QBase^.MsgHdr.Board]);
      INC(QBase^.MsgInfo.HighMsg);
      QBase^.MsgHdr.MsgNum:=QBase^.MsgInfo.HighMsg;
      WITH QBase^.MsgIdx DO
      BEGIN
        Board:=QBase^.MsgHdr.Board;
        MsgNum:=QBase^.MsgHdr.MsgNum;
      END;
      QBase^.MsgIdxFile.PutRec(QBase^.MsgIdx,QBase^.MsgIdxFile.FILESIZE);
      WITH QBase^ DO
      BEGIN
        IF MsgHdr.Msgattr AND qbReceived<>0 THEN MsgToIdx:='* Received *'
                                            ELSE MsgToIdx:=MsgHdr.WhoTo;
        MsgToIdxFile.PutRec(MsgToIdx,MsgToIdxFile.FILESIZE);
        MsgHdr.StartRec:=QBase^.MsgTxtFile.FileSize;
      END;
      WITH QBase^ DO
      BEGIN
        MsgTxtNum:=0;
        i:=MsgStart+1;
        REPEAT
          REPEAT
            INC(MsgTxtNum);
            IF i+255<=MsgSlut THEN Num:=255 ELSE Num:=MsgSlut-i+1;
            MsgTxtTab[MsgTxtNum][0]:=CHAR(Num);
            MoveFast(CT(BufAdr)[i],MsgTxtTab[MsgTxtNum][1],Num);
            INC(i,Num);
            INC(MsgHdr.NumRecs);
          UNTIL (i>=MsgSlut) OR (MsgTxtNum>=QBBSMsgTxtMax);
          MsgTxtFile.SEEK(MsgTxtFile.FILESIZE);
          MsgTxtFile.BLOCKWRITE(MsgTxtTab[1],MsgTxtNum);
          MsgTxtNum:=0;
        UNTIL i>=MsgSlut;
        MsgHdrFile.PutRec(MsgHdr,MsgHdrFile.FILESIZE);
      END;
    END;

    PROCEDURE SetAKA;
    BEGIN
      IF TmpAreas^.Area.UsedAKA=0 THEN CurrentAKA:=Cfg.MainAdrNum
                                  ELSE CurrentAKA:=TmpAreas^.Area.UsedAKA;
    END;

    PROCEDURE WriteMessage(TossIt:Boolean);
    LABEL
      StrangeNulPkt;
    VAR
      Test:INTEGER;
      s:STRING;
      TmpSP:SendPktPtr;
      ph:TPktHeader;
      i,j,n,dofw,sec100:WORD;

      PROCEDURE TossMessage; { Toss message in appropriate format }

        PROCEDURE TossIntoQuickBBS;
        BEGIN
          FillChar(QBase^.MsgHdr,SizeOf(QBase^.MsgHdr),0);
          WITH QBase^.MsgHdr DO
          BEGIN
            Cost:=pmh.Cost;
            IF pmh.Attr AND MsgPrivate<>0 THEN MsgAttr:=MsgAttr OR qbPrivate;
            IF pmh.Attr AND MsgRead   <>0 THEN MsgAttr:=MsgAttr OR qbReceived;
            PostTime[0]:=#5;
            MoveFast(pmh.Time[12],PostTime[1],5);
            s[0]:=#9;
            MoveFast(pmh.Time[1],s[1],9);
            PostDate:=DateToDateString('mm-dd-yy',DateStringToDate('dd nnn yy',s));
            DestZone:=Cfg.Addresses[CurrentAKA].Zone;
            OrigZone:=Cfg.Addresses[CurrentAKA].Zone;
            DestNet:=pmh.DestNet;
            DestNode:=pmh.DestNode;
            OrigNet:=pmh.OrigNet;
            OrigNode:=pmh.OrigNode;
            WhoTo:=Msg^.WhoTo;
            WhoFrom:=Msg^.WhoFrom;
            Subj:=Msg^.Subject;
          END;
          WITH QBase^ DO
          BEGIN
            IF Msg^.Tag<>'' THEN i:=TagEndPos ELSE i:=0;
            IF TmpAreas^.Area.ImportSB THEN MsgSlut:=SeenByOffSet ELSE MsgSlut:=RealMsgLen-1;
            WriteHudsonMessage(Msg^.TextBody,i,MsgSlut,TmpAreas^.QNum);
          END;
        END;

        PROCEDURE TossIntoMsg;
        BEGIN
          IF OpusBase^[ScannerAreaNum]=-1 THEN
          BEGIN
            OpusBase^[ScannerAreaNum]:=GetHighestMsg(TmpAreas^.Area.Directory^);
            IF OpusBase^[ScannerAreaNum]=0 THEN OpusBase^[ScannerAreaNum]:=1;
          END;
          TossIntoArea(TmpAreas^.Area.Directory^,OpusBase^[ScannerAreaNum],7+LENGTH(Msg^.Tag));
        END;

      BEGIN
        IF TmpAreas^.Area.ImportSB THEN
        BEGIN
          SeenByOffset:=RealMsgLen;
          PrepareMessageBuffer(True);
        END;
        TmpAreas^.NewMail:=True;
        IF TmpAreas^.Area.Directory^<>'' THEN
        BEGIN
          CASE Cfg.BBS.BBSType OF
            btQBBS,btRA,btSBBS        : TossIntoQuickBBS;
            btOpus110,btOpus170,btMax : TossIntoMsg;
          END;
          INC(MsgTossedCount);
          Message(LongIntForm('########',MsgTossedCount),12);
        END;
      END;

    BEGIN
      SetAKA;
      WITH pmh DO
      BEGIN
        orignet:=Cfg.Addresses[CurrentAKA].Net;
        orignode:=Cfg.Addresses[CurrentAKA].Node;
      END;
      FOR j:=1 TO 2 DO
        FOR i:=1 TO TmpAreas^.SendNum[j] DO
        BEGIN
          IF NOT IsInSeenBy[j,i] THEN
          BEGIN
            TmpSP:=SendPkt;
            WHILE (TmpSP<>NIL) AND (NOT CmpAdr(SendToTabType(TmpAreas^.SendTo[j]^)[i],TmpSP^.PktAdr)) DO
              TmpSP:=TmpSP^.Next;
            IF TmpSP=NIL THEN { Open new file }
            BEGIN
              New(TmpSP);
              TmpSP^.Next:=SendPkt;
              SendPkt:=TmpSP;
              TmpSP^.PktAdr:=SendToTabType(TmpAreas^.SendTo[j]^)[i];
              Assign(TmpSP^.PktFile,HoldFileName(TmpSP^.PktAdr,True)+'PTM'); FileMode:=ShareRW+ShareDenyRW;
              TmpSP^.PktBufPos:=0;
{$IFDEF DPMI}
              IF MaxAvail>1024*1024 THEN TmpSp^.PktBufSiz:=65521 ELSE
{$ENDIF}
                IF MaxAvail>256000 THEN TmpSP^.PktBufSiz:=20480 ELSE
                  IF MaxAvail>204800 THEN TmpSP^.PktBufSiz:=16384 ELSE
                    IF MaxAvail>153600 THEN TmpSP^.PktBufSiz:=12288 ELSE
                      IF MaxAvail>102400 THEN TmpSP^.PktBufSiz:=8192 ELSE
                        IF MaxAvail>30720 THEN TmpSP^.PktBufSiz:=4096 ELSE
                          TmpSP^.PktBufSiz:=0;
              IF TmpSP^.PktBufSiz>0 THEN GetMem(TmpSP^.PktBuf,TmpSp^.PktBufSiz);
              INC(PktBufCount);
              UsedMemStatus;
              Reset(TmpSP^.PktFile,1);
              IF IOResult=0 THEN
              BEGIN
                Seek(TmpSP^.PktFile,FileSize(TmpSP^.PktFile)-1);
                IF IOResult<>0 THEN
                BEGIN
                  SEEK(TmpSp^.PktFile,0);
                  GOTO StrangeNulPkt;
                END;
              END
              ELSE
              BEGIN
                REWRITE(TmpSP^.PktFile,1);
StrangeNulpkt:
                FillOutPktHeader(Cfg.Addresses[CurrentAKA],SendToTabType(TmpAreas^.SendTo[j]^)[i],ph);
                AddToPktBuffer(TmpSP,ph,SizeOf(ph));
              END;
            END;
            WITH pmh,SendToTabType(TmpAreas^.SendTo[j]^)[i] DO
            BEGIN
              destnet:=Net;
              destnode:=Node;
            END;
            AddToPktBuffer(TmpSP,pmhByte[1],SizeOf(pmh));
            s:=Msg^.WhoTo+#0+Msg^.WhoFrom+#0+Msg^.Subject+#0;
            AddToPktBuffer(TmpSP,s[1],Length(s));
            AddToPktBuffer(TmpSP,Msg^.TextBody[1],SeenByOffSet);
            INC(MsgSentCount);
          END;
        END;
      Message(LongIntForm('########',MsgSentCount),10);
      IF TossIt THEN TossMessage;
    END;

    PROCEDURE ScanTheMessage;
    BEGIN
      INC(TmpAreas^.Area.Scanned);
      SetupPathAndSeenBy;
      PrepareMessageBuffer(False);
      WriteMessage(True);
    END;

    FUNCTION ScanAllowed:Boolean;
    BEGIN
      WITH TmpAreas^.Area DO
      BEGIN
        IF ScanDate<>Today THEN
        BEGIN
          ScanDate:=Today;
          Scanned:=0;
        END;
        ScanAllowed:=((MaxScan=0) OR (Scanned<MaxScan));
      END;
    END;

    PROCEDURE FindOffSets;
    VAR
      i:WORD;
      s:STRING;
      ss:S10;
      ch:CHAR;
    BEGIN
      OriginOffSet:=0;
      SeenByOffSet:=0;
      PathOffSet:=0;
      i:=Msg^.MsgLen-1;
      s:='';
      WHILE (i>0) AND ((Msg^.TextBody[i]=#10) OR (Msg^.TextBody[i]=#13)) DO
        DEC(i);
      IF i>0 THEN
      BEGIN
        s[0]:=#12;
        s[13]:=#0;
        REPEAT
          REPEAT
            DEC(i);
          UNTIL (i=0) OR (Msg^.TextBody[i]=#13);
          IF i>0 THEN
          BEGIN
            FillChar(s[1],12,0);
            MoveFast(Msg^.TextBody[i+1],s[1],12);
            ss:=COPY(Trim(s),1,4);
            IF (s[1]<>#13) THEN
              IF (ss='SEEN') THEN
              BEGIN
                SeenByOffSet:=i+1;
                Continue;
              END ELSE
                IF ss='PATH' THEN
                BEGIN
                  PathOffSet:=i+1;
                  Continue;
                END ELSE Break;
          END ELSE Break;
        UNTIL (i=0);
        IF COPY(Trim(s),1,8)='* Origin' THEN OriginOffSet:=i+1;
      END;
    END;

    PROCEDURE ReadPathAndSeenBy;
    VAR
      l:BYTE;
      lasti,i:WORD;
      CurZone, CurNet:INTEGER;
      s:STRING;
      Flag:Boolean;
      ch:CHAR;
      ss:S10;

      PROCEDURE AddString(CONST as:STRING; VAR TabAdr; VAR Num:WORD);
      VAR
        Tab:SeenByTabType ABSOLUTE TabAdr;
        s:STRING;
        ss,sss:S30;
        p:BYTE;
        Flag:Boolean;
        n,Test:INTEGER;
        i:WORD;
      BEGIN
        IF s[LENGTH(s)]=#0 THEN DEC(s[0]);
        s:=as+' ';
        Flag:=False;
        REPEAT
          WHILE (s[1]=' ') AND (s<>'') DO
            DELETE(s,1,1);
          IF (s<>'') THEN
          BEGIN
            ss:=NextWord(' ',s);
            p:=Pos('/',ss);
            IF p>0 THEN
            BEGIN
              sss:=COPY(ss,1,p-1);
              DELETE(ss,1,LENGTH(sss)+1);
              VAL(sss,WORD(n),Test);
              IF n<>CurNet THEN
              BEGIN
                CurNet:=n;
                INC(Num,2);
                Tab[Num-1]:=-1;
                Tab[Num]:=CurNet;
              END;
            END;
            INC(Num);
            VAL(ss,Tab[Num],Test);
          END ELSE
            Flag:=True;
        UNTIL (Flag);
      END;

    BEGIN
      NumPath:=0;
      NumSeenBy:=0;
      FillChar(SeenByTab^,SizeOf(SeenByTab^),0);
      IF PathOffSet<>0 THEN
      BEGIN
        CurZone:=0; CurNet:=0;
        i:=PathOffSet;
        lasti:=i;
        REPEAT
          REPEAT
            ch:=Msg^.TextBody[i];
            INC(i);
          UNTIL (ch=#13) OR (ch=#0);
          IF ch<>#0 THEN
          BEGIN
            l:=i-lasti-1;
            MoveFast(Msg^.TextBody[lasti],s[1],l);
            s[0]:=CHAR(l);
            s:=Trim(s);
            IF COPY(s,1,4)='PATH' THEN
            BEGIN
              AddString(COPY(s,7,255),PathTab^,NumPath);
              lasti:=i;
              IF ch=#0 THEN Break;
              Continue;
            END ELSE Break;
          END ELSE Break;
        UNTIL False;
      END;
      IF SeenByOffSet<>0 THEN
      BEGIN
        CurZone:=0; CurNet:=0;
        i:=SeenByOffSet;
        IF OriginOffSet=0 THEN DEC(i);
        lasti:=i;
        REPEAT
          IF i>PathOffSet-3 THEN Break;
          REPEAT
            ch:=Msg^.TextBody[i];
            INC(i);
          UNTIL (ch=#13) OR (ch=#0);
          IF ch<>#0 THEN
          BEGIN
            l:=i-lasti-1;
            MoveFast(Msg^.TextBody[lasti],s[1],l);
            s[0]:=CHAR(l);
            s:=Trim(s);
            ss:=COPY(s,1,8);
            IF (ss='SEEN-BY:') THEN
            BEGIN
              AddString(COPY(s,10,255),SeenByTab^,NumSeenBy);
              lasti:=i;
              IF ch=#0 THEN Break;
              Continue;
            END ELSE Break;
          END ELSE Break;
        UNTIL False;
      END;
    END;

    PROCEDURE CompleteCurrentMessage;
    VAR
      s:STRING;
      i:BYTE;
    BEGIN
      s[0]:=#5;
      MoveFast(Msg^.TextBody[1],s[1],5);
      IF (s='AREA:') THEN
      BEGIN
        i:=6;
        WHILE (Msg^.TextBody[i]=' ') DO
          INC(i);
        DEC(i);
        REPEAT
          INC(i);
          IF Msg^.TextBody[i]<>#13 THEN Msg^.Tag:=Msg^.Tag+Msg^.TextBody[i];
        UNTIL Msg^.TextBody[i]=#13;
        TagEndPos:=i;
      END ELSE
        TagEndPos:=0;
      FindOffsets; { initier SeenByOffset, Path offset, og OriginOffset }
      IF SeenByOffSet>0 THEN RealMsgLen:=SeenByOffSet
                        ELSE RealMsgLen:=Msg^.MsgLen;
      ReadPathAndSeenBy; { Indlæs PathTab & SeenByTab }
    END;

    FUNCTION AreaExists:Boolean;
    VAR
      b:Boolean;
    BEGIN
      b:=False;
      TmpAreas:=AreasBBS;
      ScannerAreaNum:=1;
      WHILE (TmpAreas<>NIL) AND NOT b DO
      BEGIN
        IF TmpAreas^.Area.EchoNames[1]^=Msg^.Tag THEN b:=True ELSE
        BEGIN
          TmpAreas:=TmpAreas^.Next;
          INC(ScannerAreaNum);
        END;
      END;
      IF NOT b THEN TmpAreas:=NIL;
      AreaExists:=b;
    END;

    PROCEDURE ProcessPktFiles(CONST NodeStat: TNodeStat);
    VAR
      Ni:TNodeInfo;
      sr:SEARCHREC;

      FUNCTION GetPktChar:CHAR;
      BEGIN
        INC(BufPos);
        IF (BufPos>InBuffer) THEN
        BEGIN
          FillChar(Buffer^,MaxPktBuffer,0);
          PktFile.BLOCKREADNum(Buffer^,MaxPktBuffer,InBuffer);
          BufPos:=1;
        END;
        IF BufPos>InBuffer THEN PktEnd:=True;
        GetPktChar:=CHAR(BT(Buffer^)[BufPos]);
      END;

      PROCEDURE BuildMessages;
      LABEL
        StartAfterError;
      VAR
        i:WORD;
        b:CHAR;

        PROCEDURE PolyMorphTimeStamp;
        VAR
          s,ss:S20;
          ch:CHAR;
        BEGIN
          IF pmh.time[19]=#0 THEN
          BEGIN
            ss[0]:=#18;
            MoveFast(pmh.time,ss[1],18);
            INSERT(' ',ss,10);
            ss:=ss+#0;
            MoveFast(ss[1],pmh.time,20);
          END ELSE
          BEGIN
            ch:=pmh.time[1];
            IF NOT ((ch=' ') OR ((ch>='0') AND (ch<='9'))) THEN
            BEGIN
              s[0]:=#19;
              MoveFast(pmh.time,s[1],19);
              DELETE(s,1,4);
              ss:=COPY(s,1,10)+' '+COPY(s,11,5)+':00'+#0;
              MoveFast(ss[1],pmh.time,20);
            END;
          END;
        END;

      BEGIN
        PktError:=False;
        PktEnd:=False;
        REPEAT
          FillChar(pmh,SizeOf(Pmh),0);
          i:=0;
StartAfterError:
          REPEAT
            b:=GetPktChar;
            INC(i);
            PMHbyte[i]:=BYTE(b);
          UNTIL ((i>SIZEOF(pmh)-4) AND (b=#0)) OR (i>=SIZEOF(pmh)) OR Pktend;
          PolymorphTimeStamp;
          WITH pmh DO
          BEGIN
            CASE StartMsg OF
              0 : Exit;  {end of pkt}
              2 : BEGIN
                    INC(MsgScannedCount);
                    Message(LongIntForm('########',MsgScannedCount),8);
                    FillChar(Msg^,SizeOf(Msg^),0);
                    Msg^.OrigNode:=OrigNode;
                    Msg^.DestNode:=DestNode;
                    Msg^.OrigNet:=OrigNet;
                    Msg^.DestNet:=DestNet;
                    { Get "to name" }
                    b:=GetPktChar;
                    WHILE b<>#0 DO
                    BEGIN
                      Msg^.WhoTo:=Msg^.WhoTo+b;
                      b:=GetPktChar;
                    END;
                    { Get "from name" }
                    b:=GetPktChar;
                    WHILE b<>#0 DO
                    BEGIN
                      Msg^.WhoFrom:=Msg^.WhoFrom+b;
                      b:=GetPktChar;
                    END;
                    { Get "subject" }
                    b:=GetPktChar;
                    WHILE b<>#0 DO
                    BEGIN
                      Msg^.Subject:=Msg^.Subject+b;
                      b:=GetPktChar;
                    END;
                    b:=GetPktChar;
                    WHILE b<>#0 DO
                    BEGIN
                      INC(Msg^.MsgLen);
                      Msg^.TextBody[Msg^.MsgLen]:=b;
                      b:=GetPktChar;
                    END;
                    { Parse for area tag ( if any ) }
                    CompleteCurrentMessage;
                    { Process message here }
                    IF Msg^.Tag<>'' THEN { Wonderful, echo mail }
                    BEGIN
                      IF AreaExists THEN
                      BEGIN { All right, vi kender din slags!! }
                        IF NOT IsADupeMsg THEN { Ok, så du er altså ny her?? }
                        BEGIN
                          IF SecurityOK AND ScanAllowed THEN ScanTheMessage ELSE
                          BEGIN
                            TossIntoArea(Cfg.MailScanner.BadMsgs,BadMsgNum,1);
                            INC(MsgBadCount);
                            Message(LongIntForm('########',MsgBadCount),14);
                          END;
                        END ELSE
                        BEGIN
                          TossIntoArea(Cfg.MailScanner.SaveDupesDir,DupeMsgNum,1);
                          INC(MsgDupeCount);
                          Message(LongIntForm('########',MsgDupeCount),16);
                        END;
                      END ELSE
                      BEGIN { Orphan message, no known area }
                        TossIntoArea(Cfg.MailScanner.BadMsgs,BadMsgNum,1);
                        INC(MsgBadCount);
                        Message(LongIntForm('########',MsgBadCount),14);
                      END;
                    END ELSE
                    BEGIN { The damn thing is a matrix }
                      TossIntoArea(Cfg.MailScanner.NetMailDir,MatrixNum,1);
                    END;
                  END;
              ELSE
              BEGIN
                REPEAT
                  b:=GetPktChar;
                  pmhbyte[1]:=BYTE(b);
                UNTIL (PktEnd) OR (b=#2);
                IF PktEnd THEN
                BEGIN
                  Message('Error in PKT - aborting',2);
                  PktError:=True;
                END ELSE
                BEGIN
                  i:=1;
                  GOTO StartAfterError;
                END;
                Exit;
              END;
            END;
          END;
        UNTIL False;
      END;

    BEGIN
      FindFirst('*.PKT',AnyFile,Sr);
      WHILE DOSError=0 DO
      BEGIN
        Message(sr.name,4);
        PktFile.OpenWithMode(Sr.Name, 1, False, ShareRW+ShareDenyW);
        PktFile.BlockReadNum(Buffer^, SizeOf(TPktHeader), InBuffer);
        IF InBuffer=SizeOf(TPktHeader) THEN
        BEGIN
          GetPktHeadInfo(TPktHeader(Buffer^),PktOrig,PktDest);
          FindNodeInfo(Ni,PktOrig);
          IF Trim(StUpCase(AsciiZ2Str(TPktHeader(Buffer^).PassWord,7)))=Ni.PktPassWord THEN
          BEGIN
            Message('Tossing mail packet from '+Address2Str(PktOrig),2);
            BufPos:=0;
            InBuffer:=0;
            BuildMessages;
          END
          ELSE
          BEGIN
            PktError:=True;
            AddLog('!','Packet '+sr.name+' has invalid password. Us="'+Ni.PktPassWord+
                       '" Remote="'+StUpCase(AsciiZ2Str(TPktHeader(Buffer^).PassWord,7))+'"');
          END;
        END ELSE
          Message(Sr.Name+' is a short packet - deleting',2);
        PktFile.Close;
        IF NOT PktError THEN
          DeleteFile(Sr.Name)
        ELSE
          CopyFile(Cfg.Inbound[NodeStat]+sr.name,Cfg.FwdFile.SecureDir+sr.name,False,True);
        FindNext(Sr);
      END;
      FindClose(Sr);
    END;

    PROCEDURE DisposePktFiles;
    VAR
      tmp:SendPktPtr;
      ch:CHAR;
      BusyFile:FILE;
    BEGIN
      ch:=#0;
      WHILE SendPkt<>NIL DO
      BEGIN
        Tmp:=SendPkt;
        SendPkt:=SendPkt^.Next;
        AddToPktBuffer(Tmp,ch,1);
        FlushPkt(Tmp);
        Close(Tmp^.PktFile);
        IF MarkNodeBusy(BusyFile,Tmp^.PktAdr) THEN
        BEGIN
          RENAME(Tmp^.PktFile,HoldFileName(Tmp^.PktAdr,True)+'OUT');
          InOutRes:=0;
          UnMarkNodeBusy(BusyFile);
        END;
        IF Tmp^.PktBufSiz>0 THEN FreeMem(Tmp^.PktBuf,Tmp^.PktBufSiz);
        Dispose(Tmp);
      END;
    END;

    FUNCTION MailExt(Day:BYTE):S2;
    BEGIN
      MailExt:=StUpCase(COPY(DayString[DayType(Day)],1,2));
    END;

    PROCEDURE ScanBadMsgs;
    VAR
      p : Pointer;
      i : WORD;
      TxtLen: LongInt;
      h:MsgHdrType;

    BEGIN
      Message('Scanning BAD message area',2);
      FOR i:=1 TO GetHighestMsg(Cfg.MailScanner.BadMsgs) DO
      BEGIN
        IF ReadMsg(Cfg.MailScanner.BadMsgs,i,h,TxtLen,p) THEN
        BEGIN
          Message(Long2Str(i)+'.MSG',4);
          OpusMsgToMSMsg(h,p,TxtLen,Msg);
          WITH pmh DO
          BEGIN
            startmsg:=2;
            orignode:=Msg^.OrigNode;
            destnode:=Msg^.DestNode;
            orignet:=Msg^.OrigNet;
            destnet:=Msg^.DestNet;
            attr:=h.attribute;
            cost:=h.cost;
            MoveFast(h.datetime,pmh.time,20);
          END;
          CompleteCurrentMessage;
          IF AreaExists THEN
          BEGIN
            IF SecurityOK AND ScanAllowed THEN
            BEGIN
              IsADupeMsg;
              ScanTheMessage;
              DeleteFile(Cfg.MailScanner.BadMsgs+Long2Str(i)+'.MSG');
            END;
          END;
          FreeMemCheck(p,TxtLen);
        END;
      END;
      Message('',2);
    END;

    FUNCTION QBbsTime2MsgTime(VAR m:HudsonHdrRecord):S20;
    VAR
      s:S20;
    BEGIN
      s:=DateToDateString('dd nnn yy  ',DateStringToDate('mm-dd-yy',m.PostDate))+
         TimeToTimeString('hh:mm',TimeStringToTime('hh:mm',m.PostTime))+':00'#0;
      QBbsTime2MsgTime:=s;
    END;

    FUNCTION FindAreaTag(CONST Loc: PathStr): S40;
    VAR
      ss,s:PathStr;
      p:BYTE;
    BEGIN
      s:='';
      TmpAreas:=AreasBBS;
      WHILE (TmpAreas<>NIL) AND (s='') DO
      BEGIN
        ss:=TmpAreas^.Area.Directory^;
        p:=POS('\',ss);
        WHILE p>0 DO
        BEGIN
          DELETE(ss,1,p);
          p:=POS('\',ss);
        END;
        IF ss=Loc THEN s:=TmpAreas^.Area.EchoNames[1]^;
        TmpAreas:=TmpAreas^.Next;
      END;
      FindAreaTag:=s;
    END;

    PROCEDURE ImportNetMail;
    VAR
      x,i:WORD;
      l : LongInt;
      Test:INTEGER;
      p:Pointer;
      h:MsgHdrType;
      Orig,Adr:TFidoAddress;
      s:STRING;
    BEGIN
      IF (Cfg.BBS.BBSType IN [btQBBS, btRA, btSBBS]) AND (Cfg.MailScanner.NetMailBoard>0) THEN
      BEGIN
        Message('Importing messages from external netmail area',2);
        FOR i:=1 TO GetHighestMsg(Cfg.MailScanner.NetMailDir) DO
        BEGIN
          Message('Checking msg #'+Long2Str(i),4);
          IF ReadMsg(Cfg.MailScanner.NetMailDir,i,h,l,p) THEN
          BEGIN
            s[0]:=#5;
            MoveFast(p^,s[1],5);
            IF s<>'AREA:' THEN
            BEGIN
              FindMsgAdr(h,p,l,Orig,Adr);
              IF IsOurAddress(Adr) THEN
              BEGIN
                Message('Importing msg #'+Long2Str(i)+' From '+Address2Str(Orig),4);
                AddLog('#','Importing msg #'+Long2Str(i)+' From '+Address2Str(Orig));
                WITH QBase^ DO
                BEGIN
                  FillChar(MsgHdr,SizeOf(MsgHdr),0);
                  WITH MsgHdr DO
                  BEGIN
                    Cost:=pmh.Cost;
                    IF h.Attribute AND MsgPrivate<>0 THEN MsgAttr:=MsgAttr OR qbPrivate;
                    IF h.Attribute AND MsgRead   <>0 THEN MsgAttr:=MsgAttr OR qbReceived;
                    IF h.Attribute AND MsgSent   <>0 THEN MsgAttr:=MsgAttr OR qbSent;
                    IF h.Attribute AND MsgFile   <>0 THEN MsgAttr:=MsgAttr OR qbFileAttach;
                    PostTime[0]:=#5;
                    MoveFast(h.DateTime[11],PostTime[1],5);
                    s[0]:=#9;
                    MoveFast(h.DateTime[0],s[1],9);
                    PostDate:=DateToDateString('mm-dd-yy',DateStringToDate('dd nnn yy',s));
                    DestZone:=Cfg.Addresses[CurrentAKA].Zone;
                    OrigZone:=Cfg.Addresses[CurrentAKA].Zone;
                    DestNet:=h.DestNet;
                    DestNode:=h.DestNode;
                    OrigNet:=h.OrigNet;
                    OrigNode:=h.OrigNode;
                    WhoTo:=AsciiZ2Str(h.ToUser,36);
                    WhoFrom:=AsciiZ2Str(h.FromUser,36);
                    Subj:=AsciiZ2Str(h.Subject,72);
                  END;
                END;
                WriteHudsonMessage(p^,0,l,Cfg.MailScanner.NetMailBoard);
                DeleteFile(Cfg.MailScanner.NetMailDir+Long2Str(i)+'.MSG');
              END;
            END;
            FreeMemCheck(p,l);
          END;
        END;
      END;
      Message('',2);
    END;

    PROCEDURE ScanMessageBase;

      PROCEDURE ScanQBBSMessageBase;
      VAR
        i,n:WORD;
        s:STRING;

        PROCEDURE ExportNetMail;
        VAR
          i,j:WORD;
          l: LongInt;
          s:S20;
          h:MsgHdrType;
          p:Pointer;
          orig,dest:TFidoAddress;
        BEGIN
          FillChar(Msg^,SizeOf(Msg^),0);
          FillChar(pmh,SizeOf(pmh),0);
          WITH Msg^,QBase^ DO
          BEGIN
            s:=QbbsTime2MsgTime(MsgHdr);
            MoveFast(s[1],pmh.time,20);
            WhoTo:=MsgHdr.WhoTo;
            WhoFrom:=MsgHdr.WhoFrom;
            Subject:=MsgHdr.Subj;
            pmh.OrigNet:=MsgHdr.OrigNet;
            pmh.OrigNode:=MsgHdr.OrigNode;
            pmh.DestNet:=MsgHdr.DestNet;
            pmh.DestNode:=MsgHdr.DestNode;
            pmh.cost:=MsgHdr.Cost;
            MsgTxtFile.SEEK(MsgHdr.StartRec);
            FOR i:=1 TO MsgHdr.NumRecs DO
            BEGIN
              MsgTxtFile.Read(MsgTxtTab[1],nokeep,wait);
              FOR j:=1 TO LENGTH(MsgTxtTab[1]) DO
                IF MsgTxtTab[1][j]<>#0 THEN
                BEGIN
                  INC(MsgLen);
                  TextBody[MsgLen]:=MsgTxtTab[1][j];
                END;
            END;

            pmh.attr:=0;

            IF MsgHdr.MsgAttr AND qbPrivate<>0  THEN pmh.attr:=pmh.attr OR MsgPrivate;
            IF MsgHdr.MsgAttr AND qbReceived<>0 THEN pmh.attr:=pmh.attr OR MsgRead;
            IF MsgHdr.MsgAttr AND qbLocal<>0    THEN pmh.attr:=pmh.attr OR MsgLocal;

            IF MsgHdr.NetAttr AND qbKill<>0       THEN pmh.attr:=pmh.attr OR MsgKill;
            IF MsgHdr.NetAttr AND qbFileAttach<>0 THEN pmh.attr:=pmh.attr OR MsgFile;
            IF MsgHdr.NetAttr AND qbCrash<>0      THEN pmh.attr:=pmh.attr OR MsgCrash;
            IF MsgHdr.NetAttr AND qbReqRcpt<>0    THEN pmh.attr:=pmh.attr OR MsgRcpt;
            IF MsgHdr.NetAttr AND qbAuditReq<>0   THEN pmh.attr:=pmh.attr OR MsgAReq;
            IF MsgHdr.NetAttr AND qbReturnRcpt<>0 THEN pmh.attr:=pmh.attr OR MsgRReq;

            TossIntoArea(Cfg.MailScanner.NetMailDir,MatrixNum,1);
            MsgHdr.MsgAttr:=MsgHdr.MsgAttr XOR qbSent;
            MsgHdr.NetAttr:=MsgHdr.NetAttr XOR qbSent;
            IF MsgHdr.NetAttr AND qbKill<>0 THEN
            BEGIN
              MsgHdr.MsgAttr:=MsgHdr.MsgAttr OR 1;
              MsgToIdx:='* Deleted *';
              MsgToIdxFile.PutRec(MsgToIdx,MsgHdrFile.FILEPOS-1);
              MsgIdxFile.GetRec(MsgIdx,MsgHdrFile.FILEPOS-1,Keep,Wait);
              MsgIdx.MsgNum:=-1;
              MsgIdxFile.PutRec(MsgIdx,MsgHdrFile.FILEPOS-1);
              IF MsgInfo.TotalActive>0 THEN DEC(MsgInfo.TotalActive);
              IF MsgInfo.ActiveMsgs[MsgHdr.Board]>0 THEN DEC(MsgInfo.ActiveMsgs[MsgHdr.Board]);
              MsgInfoFile.PutRec(MsgInfo,0);
            END;
            MsgHdrFile.PutRec(MsgHdr,MsgHdrFile.FILEPOS-1);
            IF ReadMsg(Cfg.MailScanner.NetMailDir,MatrixNum,h,l,p) THEN
            BEGIN
              FindMsgAdr(h,p,l,Orig,Dest);
              AddLog('#','Exporting net mail from '+Address2Str(Orig)+' to '+Address2Str(Dest));
              FreeMemCheck(p,l);
            END;
          END;
        END;

      BEGIN
        WITH QBase^ DO
        BEGIN
          WHILE NOT MsgHdrFile.EOF DO
          BEGIN
            MsgHdrFile.Read(MsgHdr,NoKeep,Wait);
            IF (MsgHdr.MsgAttr AND 7)=6 THEN
              ExportNetMail
            ELSE
              IF MsgHdr.MsgAttr AND 33=32 THEN
              BEGIN
                { Send message here }
                FillChar(Msg^,SizeOf(Msg^),0);
                Msg^.Tag:=FindAreaTag(Long2Str(MsgHdr.Board));
                IF AreaExists THEN
                BEGIN
                  SetAKA;
                  FillChar(pmh,SIZEOF(pmh),0);
                  WITH Pmh DO
                  BEGIN
                    startmsg:=2;
                    orignode:=MsgHdr.OrigNode;
                    destnode:=MsgHdr.DestNode;
                    orignet:=MsgHdr.OrigNet;
                    destnet:=MsgHdr.DestNet;
                    IF MsgHdr.MsgAttr AND 8=8   THEN attr:=attr OR MsgPrivate;
                    IF MsgHdr.MsgAttr AND 16=16 THEN attr:=attr OR MsgRead;
                    cost:=MsgHdr.Cost;
                    s:=QBbsTime2MsgTime(MsgHdr);
                    MoveFast(s[1],time,20);
                    WITH MsgHdr DO
                    BEGIN
                      Msg^.WhoTo:=WhoTo;
                      Msg^.WhoFrom:=WhoFrom;
                      Msg^.Subject:=Subj;
                    END;
                  END;
                  IF NOT IsADupeMsg THEN
                  BEGIN
                    WITH MsgHdr DO
                    BEGIN
                      OrigNet:=Cfg.Addresses[CurrentAKA].Net;
                      OrigNode:=Cfg.Addresses[CurrentAKA].Node;
                      s:='AREA:'+Msg^.Tag+#13;
                      MoveFast(s[1],Msg^.TextBody,LENGTH(s));
                      Msg^.MsgLen:=LENGTH(s);
                      MsgTxtFile.SEEK(StartRec);
                      FOR n:=1 TO NumRecs DO
                      BEGIN
                        MsgTxtFile.Read(MsgTxtTab[1],NoKeep,Wait);
                        FOR i:=1 TO LENGTH(MsgTxtTab[1]) DO
                          IF MsgTxtTab[1][i]<>#0 THEN
                          BEGIN
                            INC(Msg^.MsgLen);
                            Msg^.TextBody[Msg^.MsgLen]:=MsgTxtTab[1][i];
                          END;
                      END;
                    END;
                    INC(Msg^.MsgLen);
                    InitPathAndSeenBy;
                    PrepareMessageBuffer(False);
                    WriteMessage(False);
                  END;
                  { Mark message as sent }
                  MsgHdr.MsgAttr:=MsgHdr.MsgAttr AND 255-32;
                  MsgHdrFile.PutRec(MsgHdr,MsgHdrFile.FILEPOS-1);
                END;
              END;
          END;
        END;
        DeleteFile(BasePath+'NETMAIL.BBS');
        DeleteFile(BasePath+'ECHOMAIL.BBS');
      END;

      PROCEDURE ScanMsgMessageBase;
      CONST
        HWMTekst='PORTAL ECHO MAIL SYSTEM';
      VAR
        ss,s:PathStr;
        Last,i:WORD;
        Len : LongInt;
        h:MsgHdrType;
        p:Pointer;

        FUNCTION ScanStart(CONST Path: PathStr): WORD;
        VAR
          Len: LongInt;
          p:Pointer;
          h:MsgHdrType;
        BEGIN
          ScanStart:=1;
          IF ReadMsg(Path,1,h,Len,p) THEN
          BEGIN
            IF AsciiZ2Str(h.ToUser,36)=HWMTekst THEN ScanStart:=h.ReplyTo;
            FreeMemCheck(p,Len);
          END;
        END;

        PROCEDURE SetHWM(CONST Path: PathStr; Num:WORD);
        VAR
          Len:WORD;
          h:MsgHdrType;
        BEGIN
          FillChar(h,SIZEOF(h),0);
          h.Attribute:=MsgPrivate+MsgRead+MsgSent;
          Str2AsciiZ(HWMTekst,h.ToUser,36);
          h.ReplyTo:=Num;
          WriteMsg(Path,1,h,0,NIL);
        END;

      BEGIN
        TmpAreas:=AreasBBS;
        WHILE (TmpAreas<>NIL) DO
        BEGIN
          IF TmpAreas^.Area.Directory^<>'' THEN
          BEGIN
            SetAKA;
            s:=TmpAreas^.Area.Directory^;
            Last:=GetHighestMsg(s);
            FOR i:=ScanStart(s) TO Last DO
            BEGIN
              IF ReadMsg(s,i,h,Len,p) THEN
              BEGIN
                IF h.Attribute AND MsgSent=0 THEN
                BEGIN
                  OpusMsgToMSMsg(h,p,Len,Msg);
                  Msg^.Tag:=TmpAreas^.Area.EchoNames[1]^;
                  IF NOT IsADupeMsg THEN
                  BEGIN
                    ss:='AREA:'+TmpAreas^.Area.EchoNames[1]^+#13;
                    MoveFast(Msg^.TextBody,Msg^.TextBody[LENGTH(ss)+1],Msg^.MsgLen);
                    MoveFast(ss[1],Msg^.TextBody,LENGTH(ss));
                    INC(Msg^.MsgLen,LENGTH(ss));
                    InitPathAndSeenBy;
                    SetupPathAndSeenBy;
                    PrepareMessageBuffer(False);
                    DEC(SeenByOffSet);
                    WITH pmh DO
                    BEGIN
                      StartMsg:=2;
                      orignode:=h.orignode;
                      destnode:=h.destnode;
                      orignet:=h.orignet;
                      destnet:=h.destnet;
                      attr:=h.attribute;
                      cost:=h.cost;
                      MoveFast(h.datetime,pmh.time,20);
                    END;
                    WriteMessage(False);
                  END;
                  h.Attribute:=h.Attribute OR MsgSent;
                  WriteMsg(s,i,h,Len,p);
                END;

                FreeMemCheck(p,Len);
              END;
              SetHWM(TmpAreas^.Area.Directory^,Last);
            END;
          END;
          TmpAreas:=TmpAreas^.Next;
        END;
      END;

    BEGIN
      Message('Scanning for outgoing mail',2);
      CASE Cfg.BBS.BBSType OF
        btQBBS,btRA,btSBBS        : ScanQBBSMessageBase;
        btOpus110,btOpus170,btMax : ScanMsgMessageBase;
      END;
    END;

    FUNCTION IsAMailBundle(CONST s: S12):Boolean;
    VAR
      l:LongInt;
      test:INTEGER;
    BEGIN
      IsAMailBundle:=False;
      IF LENGTH(s)<>12 THEN Exit;
      IF (s[12]<'0') OR (s[12]>'9') THEN Exit;
      VAL('$'+COPY(s,1,8),l,test);
      IF test<>0 THEN Exit;
      IsAMailBundle:=True;
    END;

    PROCEDURE CleanUpDupesDir;
    VAR
      Num,i:WORD;
      sr:SEARCHREC;
    BEGIN
      Message('Checking/cleaning dupes directory',2);
      Num:=0;
      FindFirst(Cfg.MailScanner.SaveDupesDir+'*.MSG',Archive,sr);
      WHILE DOSERROR=0 DO
      BEGIN
        INC(Num);
        FINDNEXT(sr);
      END;
      FindClose(sr);
      i:=0;
      WHILE Num>Cfg.MailScanner.MaxDupes DO
      BEGIN
        REPEAT
          INC(i);
        UNTIL DeleteFile(Cfg.MailScanner.SaveDupesDir+Long2Str(i)+'.MSG');
        DEC(Num);
      END;
    END;

    PROCEDURE WriteStat;
    VAR
      Tim:LongInt;

      FUNCTION Average(l:LongInt):S20;
      VAR
        s:S20;
      BEGIN
        Average:='';
        IF l<>0 THEN
        BEGIN
          STR(l/Tim:0:1,s);
          Average:=', '+s+'/second';
        END ELSE Average:='';
      END;

    BEGIN
      Tim:=StopMSTimer;
      AddLog('#','Mail scanner time '+Long2Str(Tim)+' second(s)');
      AddLog('#','Scanned '+Long2Str(MsgScannedCount)+' message(s)'+Average(MsgScannedCount));
      AddLog('#','Tossed '+Long2Str(MsgTossedCount)+' message(s)'+Average(MsgTossedCount));
      AddLog('#','Sent '+Long2Str(MsgSentCount)+' message(s). '+Average(MsgSentCount));
    END;

    FUNCTION IsOurFile(CONST FName: PathStr):Boolean;
    VAR
      f:FILE;
    BEGIN
      IsOurFile:=False;
      Assign(f,FName); FileMode:=ShareRW; Reset(f,1);
      IF IOResult=0 THEN Close(f) ELSE Exit;
      IsOurFile:=True;
    END;

    PROCEDURE SaveAllMemDupes;
    VAR
      i:BYTE;
    BEGIN
      i:=0;
      REPEAT
        INC(i);
        IF Dupe[i]^.d.Tag<>'' THEN
          DupeFile.PutRec(Dupe[i]^.d,Dupe[i]^.DFPos)
        ELSE
          Break;
      UNTIL (i=MaxDupeBases);
    END;

  BEGIN
    GetMem(Buffer, MaxPktBuffer);
    SendPkt:=NIL;
    ScanBadMsgs;
    IF Cfg.BBS.BBSType IN [btQBBS,btRA,btSBBS] THEN
    BEGIN
      QBase^.MsgInfoFile.Lock(1,wait);
      QBase^.MsgInfoFile.GetRec(QBase^.MsgInfo,0,NoKeep,Wait);
    END;
    GetDT(MSTimer);
    IF RunParametersType(GemRp).Toss THEN
    BEGIN
      FOR NodeStat:=nsUnKnown TO nsPassword DO
      BEGIN
        IF (Cfg.InboundToDo[NodeStat] AND itd_Mail)<>0 THEN
        BEGIN
          ChangeDir(Cfg.Inbound[NodeStat]);
          ProcessPktFiles(NodeStat);
          FOR i:=0 TO 6 DO
          BEGIN
            FindFirst('????????.'+MailExt(i)+'?',Archive,Sr);
            WHILE DOSError=0 DO
            BEGIN
              IF IsAMailBundle(sr.name) AND (IsOurFile(sr.name)) THEN
              BEGIN
                Message('Unpacking mail bundle '+Sr.Name,2);
                IF NOT ArcCommand(ArcType(Sr.Name),2,Sr.Name,'*.PKT') THEN
                BEGIN
                  AddLog('!','Error unpacking '+sr.name+', moving it to '+Cfg.FwdFile.SecureDir);
                  CopyFile(Cfg.Inbound[NodeStat]+sr.name,Cfg.FwdFile.SecureDir+sr.name,False,True);
                  FINDFIRST(Cfg.Inbound[NodeStat]+'*.PKT',Archive,delsr);
                  WHILE DOSERROR=0 DO
                  BEGIN
                    DeleteFile(Cfg.Inbound[NodeStat]+DelSr.name);
                    FINDNEXT(DelSr);
                  END;
                  FindClose(DelSr);
                END ELSE
                BEGIN
                  DeleteFile(Cfg.Inbound[NodeStat]+sr.name);
                  ProcessPktFiles(NodeStat);
                END;
              END;
              FindNext(Sr);
            END;
            FindClose(Sr);
          END;
        END;
      END;
      Message('Writing toss log',2);
      WriteEchoTossLog(AreasBBS);
      ChangeDir(StartPath);
      ScanNetMail;
      ImportNetMail;
      IF (Cfg.MailScanner.SaveDupesDir<>'') AND (Cfg.MailScanner.MaxDupes<>0) THEN
        CleanUpDupesDir;
    END;
    IF RunParametersType(GemRp).Scan THEN ScanMessageBase;
    IF Cfg.BBS.BBSType IN [btQBBS,btRA,btSBBS] THEN
      WITH QBase^ DO
      BEGIN
        MsgInfoFile.PutRec(MsgInfo,0);
        MsgInfoFile.UnLock(1);
      END;
    WriteStat;
    SaveAllMemDupes;
    DisposePktFiles;
    FreeMem(Buffer, MaxPktBuffer);
    Message('Updating Echo mail areas',2);
    DisposeAreasBBS(AreasBBS);
    DupeFile.Close;
    IF RunParametersType(GemRp).Pack THEN
    BEGIN
      Message('Packing and routing mail',2);
      Message('',4);
      Message('Net mail directory '+Cfg.MailScanner.NetMailDir,6);
      PerformPacking(RunParametersType(GemRp).Sched);
    END;
  END;

  PROCEDURE SetUpMessageBase;
  VAR
    i:WORD;
  BEGIN
    Message('Initializing message system',2);
    MsgScannedCount:=0;
    MsgSentCount:=0;
    MsgTossedCount:=0;
    MsgBadCount:=0;
    MsgDupeCount:=0;
    IF POS('\',AreasBBS^.Area.Directory^)>0 THEN
    BEGIN
      i:=LENGTH(AreasBBS^.Area.Directory^);
      WHILE AreasBBS^.Area.Directory^[i]<>'\' DO
        DEC(i);
      BasePath:=COPY(AreasBBS^.Area.Directory^,1,i);
    END ELSE
      BasePath:=StartPath;
    CASE Cfg.BBS.BBSType OF
      btQBBS,
      btRA,
      btSBBS : BEGIN
            New(QBase);
            WITH QBase^ DO
            BEGIN
              MsgInfoFile.Open(BasePath+'MSGINFO.BBS',SizeOf(HudsonInfoRecord),True);
              IF MsgInfoFile.FILESIZE=0 THEN
              BEGIN
                FillChar(MsgInfo,SizeOf(HudsonInfoRecord),0);
                MsgInfoFile.PutRec(MsgInfo,0);
              END ELSE
                MsgInfoFile.GetRec(MsgInfo,0,NoKeep,Wait);
              MsgToIdxFile.Open(BasePath+'MSGTOIDX.BBS',SizeOf(S35),True);
              MsgIdxFile.Open(BasePath+'MSGIDX.BBS',SizeOf(HudsonIdxRecord),True);
              MsgHdrFile.Open(BasePath+'MSGHDR.BBS',SizeOf(HudsonHdrRecord),True);
              MsgTxtFile.Open(BasePath+'MSGTXT.BBS',SizeOf(S255),True);
            END;
          END;
      btOpus110,
      btOpus170,
      btMax : BEGIN
            New(OpusBase);
            FOR i:=1 TO 1000 DO
              OpusBase^[i]:=-1;
          END;
    END;
  END;

  PROCEDURE FinishMessageBase;
  BEGIN
    Message('Cleaning up',2);
    CASE Cfg.BBS.BBSType OF
      btQBBS,
      btRA,
      btSBBS : BEGIN
            WITH QBase^ DO
            BEGIN
              MsgToIdxFile.Close;
              MsgIdxFile.Close;
              MsgHdrFile.Close;
              MsgTxtFile.Close;
              MsgInfoFile.Close;
            END;
            Dispose(QBase);
          END;
      btOpus110,
      btOpus170,
      btMax : Dispose(OpusBase);
    END;
  END;

BEGIN
  CurrentAKA:=Cfg.MainAdrNum;
  GetEsr(EsrMailScanParams,2,Esr);
  Esr.SetWrapMode(ExitAtBot);
  rp:=Esr.GetUserRecord;
  IF Flags=0 THEN
  BEGIN
    RunParametersType(rp^).Toss:=(CurrentEvent.Typ AND etTossMail<>0);
    RunParametersType(rp^).Pack:=(CurrentEvent.Typ AND etPackMail<>0);
    RunParametersType(rp^).Scan:=(CurrentEvent.Typ AND etScanMail<>0);
    RunParametersType(rp^).Sched:=0;
    Esr.Process;
    Cmd:=Esr.GetLastCommand;
    GemRp:=RunParametersType(rp^);
    Esr.Done;
  END ELSE
  BEGIN
    Cmd:=ccDone;
    GemRp.Toss:=(Flags AND etTossMail<>0);
    GemRp.Pack:=(Flags AND etPackMail<>0);
    GemRp.Scan:=(Flags AND etScanMail<>0);
    GemRp.Sched:=CurrentEvent.SchedNumber;
  END;
  IF Cmd<>ccQuit THEN
  BEGIN
    GetDT(StartTime);
    FreeUpMemory;
    MyWin(MailScanWin,1,2,80,25,2,'Doing Mailscan',False);
    WITH MailScanWin^ DO
    BEGIN
      wFastText('Action      :', 2, 2);
      wFastText('Current file:', 4, 2);
      wFastText('Current area:', 6, 2);
      wFastText('# Scanned   :', 8, 2);
      wFastText('# Sent      :',10, 2);
      wFastText('# Tossed    :',12, 2);
      wFastText('# Bad msgs. :',14, 2);
      wFastText('# Dupe msgs.:',16, 2);
      wFastText('Memory usage:',18, 2);
    END;
    OldTagName:='';
    PktBufCount:=0;
    FOR i:=1 TO MaxDupeBases DO
    BEGIN
      New(Dupe[i]);
      FillChar(Dupe[i]^,SizeOf(DupeMemType),0);
    END;
    DupeFile.Open(StartPath+PoPMsgDupeFileName,SizeOf(DupeBaseType),True);
    Message('Reading ECHO MAIL Areas, and scanning dupe database',2);
    ReadAreasBBS(AreasBBS);
    SetUpMessageBase;
    New(Msg);
    New(SeenByTab);
    New(PathTab);
    IF Cfg.MailScanner.SaveDupesDir<>'' THEN DupeMsgNum:=GetHighestMsg(Cfg.MailScanner.SaveDupesDir);
    MatrixNum:=GetHighestMsg(Cfg.MailScanner.NetMailDir);
    BadMsgNum:=GetHighestMsg(Cfg.MailScanner.BadMsgs);
{$IFDEF DPMI}
    IF MaxAvail>1024*1024 THEN MaxPktBuffer:=61440 ELSE
{$ENDIF}
      IF MaxAvail>204800 THEN MaxPktBuffer:=32768 ELSE
        IF MaxAvail>153600 THEN MaxPktBuffer:=20480 ELSE
          MaxPktBuffer:=10240;
    UsedMemStatus;
    DoMailScan;
    FOR i:=1 TO MaxDupeBases DO
      Dispose(Dupe[i]);
    Dispose(PathTab);
    Dispose(SeenByTab);
    Dispose(Msg);
    FinishMessageBase;
    KillWindow(MailScanWin);
    InitialiseNodeList(Cfg.NodeList,Cfg.NodeListTyp);
    GetDT(EndTime);
    UpdateUsageStat(StartTime,EndTime,USMailProcess);
  END;
END;

END.